home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / Dialog+ < prev    next >
Text File  |  1993-02-12  |  8KB  |  323 lines
  1. \ Dialog+ - MRH April 87.
  2.  
  3. \ This subclass of Dialog implements modeless dialogs, popup menu support,
  4. \ and other things.
  5.  
  6. \ Nov  87 mrh    Added enabling and disabling of dialogs.
  7. \ July 91 mrh    Migrated some methods to Dialog (now in a module).
  8.  
  9. need    dialog
  10.  
  11. objPtr    DLG-CHAIN    \ Head of chain of open dialogs.  When
  12.             \ DialogSelect returns TRUE, we search this
  13.             \ chain to find which which one was hit.
  14.  
  15. objPtr    ACTIVE_DLG
  16. objPtr    THIS_DLG    \ These 3 objPtrs will be set to class Dialog+.
  17.  
  18. var    DPTR        clear: dptr
  19.  
  20. handle    TEHDL
  21. \ This is a copy of the textH field of a dialog, if a dialog window
  22. \ is frontmost.  Nil otherwise.  This allows us to call TEidle in the
  23. \ main event loop when necessary, as required for the insertion point
  24. \ to blink.
  25.  
  26. handle    SaveTEhdl        \ Saves TEhdl while we're suspended
  27.  
  28. $ A0  constant    TEXTH_OFFS
  29.  
  30. : SET_TEHDL    \ ( wnd-ptr -- )
  31.         \ wnd-ptr is the (relative) address of the dialog's window,
  32.         \ which is the same as the address of the dialog record itself, 
  33.         \ as the window field comes first.  The corresponding
  34.         \ absolute address is contained in the ivar dlgPtr.
  35.  
  36.     textH_offs +  @  ?dup IF  put: teHdl  ELSE  clear: teHdl  THEN  ;
  37.  
  38.  
  39. :class  DIALOG+  super{ dialog }
  40.  
  41.     ptr        F-LINK                \ Forward link - ^dlg
  42.     ptr        B-LINK                \ Backward link ditto
  43.     bool    ENABLED?
  44.     ptr        PUM-LINK            \ Link to any pop-up menus
  45.  
  46. ' dlg-chain        set_to_class  dialog+
  47. ' active_dlg    set_to_class  dialog+
  48. ' this_dlg        set_to_class  dialog+
  49.  
  50.  
  51. :m F-LINK:    \ ( -- ^dlg )
  52.     get: f-link  ;m
  53.  
  54. \ ( ^dlg -- )
  55. :m SET-F-LINK:        put: f-link  ;m
  56. :m SET-B-LINK:        put: b-link  ;m
  57.  
  58. \ ( -- ^dlg )
  59. :m PUM-LINK:        get: PUM-link  ;m
  60. :m SET-PUM-LINK:    put: PUM-link  ;m
  61.  
  62.  
  63. :m GETNEW:
  64.     nil?: dlgPtr  0EXIT                \ Out if open already
  65.     dlg-chain  put: f-link
  66.     dlg-chain nilP =
  67.     NIF  ^base   set-b-link: dlg-chain  THEN
  68.     ^base -> dlg-chain   clear: b-link
  69.     getnew: super
  70.     get: dlgPtr  set_teHdl
  71.     0 -> actW  ;m            \ Front window is a dialog, not a Mops window
  72.  
  73.  
  74. :m CLOSE:
  75.     nil?: dlgPtr  ?EXIT                \ Out if closed already
  76.     nil?: f-link
  77.     NIF  get: b-link  get: f-link  set-b-link: dialog+  THEN
  78.     nil?: b-link
  79.     NIF        get: f-link  get: b-link  set-f-link: dialog+
  80.     ELSE    get: f-link  -> dlg-chain
  81.     THEN
  82.     clear: teHdl  nilP -> active_dlg  close: super  ;m
  83.  
  84. :m EXEC:        \ ( index -- )
  85.     get: enabled?  if  exec: super  else  drop  then   ;m
  86.  
  87. :m ENABLE:        true  put: enabled?  ;m
  88.  
  89. :m DISABLE:        false  put: enabled?  ;m
  90.  
  91. :m ENABLED?:    get: enabled?  ;m
  92.  
  93.  
  94. :m CLASSINIT:    enable: self   ;m
  95.  
  96. :m DUMP:
  97.     ^base  .h  3 spaces  nil?: dlgPtr  if  ." not "  then  ." open"
  98.     3 spaces  get: enabled?
  99.     if   ." enabled"   else   ." disabled"   then   cr
  100.     get: f-link ." f-link " .h  get: b-link ." b-link " .h
  101.     ."  dlgPtr "  get: dlgPtr .h  cr
  102.     dlg-chain ." dlg-chain " .h   ;m
  103.  
  104. ;class
  105.  
  106. \                =====================================
  107.  
  108. : FIND-DLG  { dlptr -- b }
  109.     dlg-chain -> this_dlg
  110.     BEGIN
  111.         this_dlg nilP =  IF  false  EXIT  THEN
  112.         dlgPtr: this_dlg  dlptr =
  113.         IF  true  EXIT  THEN
  114.         f-link: this_dlg  -> this_dlg
  115.     AGAIN  ;
  116.  
  117.  
  118. : DLGPORT        \ Sets the current grafport to the current dialog.
  119.     dlgPtr: this_dlg  call setPort  ;
  120.  
  121.  
  122. 0    value    EXEC?
  123.  
  124. : MLD-EVT
  125.     word0  fEvent  addr: dptr  addr: theItem
  126.     call DialogSelect  i->l  0<>  -> exec?
  127.     get: dptr  find-dlg  0EXIT
  128.     exec?  0EXIT
  129.     get: theItem  1-  exec: this_dlg  ;
  130.  
  131.  
  132. : CLOSE-DLG        \ ( dlptr -- )
  133.     find-dlg  0exit
  134.     close: this_dlg  ;
  135.  
  136. : IS_DLG_EVT?    \ ( -- b )
  137.     word0  fevent  call IsDialogEvent  i->l  ;
  138.  
  139.  
  140. \ ?TEidle calls TEidle if a modeless dialog with a TE field is current.
  141. \ We have to do this at regular intervals in order to get the insertion
  142. \ point to blink.  If the call is needed, the handle TEhdl won't be nil,
  143. \ and will be a handle to the TE field.   We arrange for this word to be
  144. \ called regularly by having our handler for null events  make the call.
  145.  
  146. : ?TEIDLE
  147.     nil?: teHdl  ?EXIT
  148.     get: teHdl  call TEidle  ;
  149.  
  150. : UPD-EV    appWind?  0EXIT  upd-evt  ;
  151.  
  152. : ACTV-EV    appWind?  0EXIT  actv-evt  ;
  153.  
  154. : NULL-EV    ?TEidle  null-evt  ;
  155.  
  156. : OS-EV        \ When the system sends us Suspend and Resume events, it doesn't
  157.             \ deactivate/activate any windows.  We have to handle it
  158.             \ ourselves.  Here we look after non-modal dialog windows.
  159.             \ Ordinary windows are handled by OS-EVT in file Event.
  160.     OS-evt
  161.     suspend?
  162.     IF    get: TEhdl  put: saveTEhdl
  163.         nil?: TEhdl
  164.         NIF  get: TEhdl  call TEDeactivate  clear: TEhdl  THEN
  165.         EXIT
  166.     THEN
  167.     resume?
  168.     IF    get: saveTEhdl  put: TEhdl
  169.         nil?: TEhdl  NIF  get: TEhdl  call TEActivate  THEN
  170.     THEN   ;
  171.  
  172.  
  173. : ERR    60 beep abort  ;
  174.  
  175. \ We set the drag limit for dialogs at the time the drag is done - this
  176. \ allows the screen size to change while a dialog is up!
  177.  
  178. rect  DRAG-LIMIT
  179.  
  180. : SET_DRAG-LIMIT
  181.     screenbits  put: drag-limit  10 10 inset: drag-limit  ;
  182.  
  183.  
  184. : ENB?        \ ( -- b )  Returns true if WND corresponds to an enabled 
  185.             \            dialog.
  186.     wnd  find-dlg  NIF  false  exit  THEN
  187.     enabled?: this_dlg  ;
  188.  
  189. : ?SELECT    \ Selects the dialog corresponding to WND, if enabled.
  190.     enb?  0EXIT
  191.     wnd  call SelectWindow  ;
  192.  
  193. : ?DRAG        \ Drags the dialog (maybe only if enabled).
  194.     enb?  0EXIT                \ Include if you don't want disabled dlgs draggable
  195.     set_drag-limit
  196.     wnd  where: fEvent
  197.     addr: drag-limit  call DragWindow  ;
  198.  
  199. : ?CLOSE    \ Handles a click in the close box if enabled.
  200.     enb?  0EXIT
  201.     wnd  dup  >r  word0  r>
  202.     where: fEvent  call TrackGoAway  word0
  203.     IF  close-dlg  ELSE  drop  THEN  ;
  204.  
  205.  
  206. : MLD-MOUSE-EVT        \ ( rgn -- )
  207.     \ Handles a click on a dialog window that was not reported
  208.     \ as a dialog event.  It could be select, drag, grow or close.
  209.     \ If the dialog is not enabled, we ignore the click.
  210.     
  211.     SELECT{
  212.         3  IS{    ?select                            }END
  213.         4  IS{    ?drag                            }END
  214.         5  IS{    ( A dialog box can't grow! )     }END
  215.         6  IS{    ?close                            }END
  216.         DEFAULT{  err
  217.     }SELECT  ;
  218.  
  219.  
  220. : MOUSE-EVT+MLD        \ ( -- false )
  221.     is_dlg_evt?  IF  MLD-evt  false  EXIT  THEN
  222.     when: fEvent  put: theMouse            \ update click interval
  223.     where: fEvent  find-window  -> wnd
  224.     wnd windowKind  2 =  ( Dialog window? )
  225.     IF        MLD-mouse-evt
  226.     ELSE    (mouse-evt)
  227.     THEN  false  ;
  228.  
  229.  
  230. : KEY-EVT+MLD        \ ( -- b )
  231.     active_dlg  nilP =
  232.     NIF    key: active_dlg  0dup  0EXIT
  233.         mods: fEvent  $ 100 and
  234.         NIF  MLD-evt  false  EXIT  THEN
  235.     THEN
  236.     key-evt  ;
  237.  
  238.  
  239. : UPD-EVT+MLD        \ ( -- false )
  240.     is_dlg_evt?
  241.     IF    MLD-evt
  242.         drawBold: this_dlg  false  EXIT
  243.     THEN
  244.     msg: fEvent  -> wnd
  245.     upd-ev  ;
  246.  
  247.  
  248. : ACTV-EVT+MLD        \ ( -- false )
  249.     msg: fEvent  -> wnd
  250.     wnd windowKind  2 =
  251.     IF    mods: fEvent 01 and
  252.         IF        ( Activate )
  253.             wnd set_TEhdl
  254.             msg: fEvent  find-dlg
  255.             if    this_dlg -> active_dlg
  256.             else    nilP -> active_dlg
  257.             then
  258.         ELSE    ( Deactivate )
  259.             clear: TEhdl  nilP -> active_dlg
  260.         THEN
  261.         is_dlg_evt?  IF  MLD-evt  false  EXIT  THEN
  262.     THEN
  263.     actv-ev  ;
  264.  
  265.  
  266. : +MODELESS
  267.     XTS{    null-ev            mouse-evt+mld    null-ev            key-evt+mld
  268.             null-ev            key-evt+mld        upd-evt+mld        disk-evt
  269.             actv-evt+mld    null-ev            null-ev            null-ev
  270.             null-ev            null-ev            null-ev            OS-ev
  271.             null-ev            null-ev            null-ev            null-ev
  272.             null-ev            null-ev            null-ev            HL-evt  }
  273.     put: fEvent
  274. \    ['] ?TEidle -> TEidle
  275.     sleepticks 0<  IF  20  ELSE  sleepticks  20 min  THEN
  276.     -> sleepticks  ;
  277.  
  278.  
  279. \ endload
  280.  
  281. \ TESTING:
  282.  
  283. \ ================== "MLD test" dialog box ==========================
  284.  
  285.     6    dialog+    D1        2 setbold: d1
  286.     4    dialog+    D2
  287.  
  288.  
  289. : QQQ        20 beep  ;
  290. : WWW         1 beep  ;
  291. : ZZZ        ." useritem hit" cr  ;
  292.  
  293.  
  294. : USER->TEMPRECT    \ ( hdl w:item# -- b )
  295.     i->l swap  find-dlg
  296.     IF        itemHandle: this_dlg  drop  true
  297.     ELSE    ( item# )  drop  false
  298.     THEN  ;
  299.  
  300.  
  301. :proc  DRAW_USER
  302.     user->tempRect
  303.     IF    " Hello"  tempRect 1 makeint call textBox
  304.         dropShadow: tempRect
  305.     THEN   ;proc
  306.  
  307.  
  308.  
  309. : CLOSE1    close: d1  ;
  310. : CLOSE2    close: d2  ;
  311.  
  312. XTS{  qqq www close1 togitem  zzz  zzz  }    300  init: d1
  313. XTS{  qqq www close2  zzz                }    301  init: d2
  314.  
  315. : GO
  316.     " MLDtest.rsrc" openresfile        \ ***
  317.     +modeless
  318.     getnew: d1  getnew: d2
  319.     ['] draw_user dup 6 setUserProc: d1  dup 5 setUserProc: d1
  320.     4 setUserProc: d2  ;
  321.  
  322. : zz  close: d1  close: d2  -modeless  ;
  323.